Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/clocks/ttcode/thetime.frm

Text File | 1995-07-25 | 49KB | 1,241 lines

VERSION 2.00
Begin Form thetime
   BackColor       =   &H00FFFFFF&
   Caption         =   "theTime"
   ClientHeight    =   1335
   ClientLeft      =   1845
   ClientTop       =   1995
   ClientWidth     =   4320
   ClipControls    =   0   'False
   Height          =   1740
   Icon            =   THETIME.FRX:0000
   KeyPreview      =   -1  'True
   Left            =   1785
   LinkTopic       =   "Form2"
   ScaleHeight     =   89
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   288
   Top             =   1650
   Visible         =   0   'False
   Width           =   4440
   Begin MsgBlaster MsgBlaster1
      Prop8           =   "Click on ""..."" for the About Box ---->"
   End
   Begin CommonDialog CMDialog1
      Left            =   0
      Top             =   360
   End
   Begin Timer Timer1
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   0
      Top             =   0
   End
   Begin PZLabel TimePan
      Height          =   1065
      Left            =   870
      PictureStyle    =   3  'Tiled
      TabIndex        =   0
      Top             =   90
      Visible         =   0   'False
      Width           =   2535
   End
End
Option Explicit

'*******************************************************
'*                                                     *
'*   theTime, a mildly interesting Windows 3.x clock   *
'*   Written by Visual Bits                            *
'*   Copyright ⌐ 1995                                  *
'*                                                     *
'*   This software and any documentation are supplied  *
'*   "AS IS".  The author makes no warranty of any     *
'*   kind, either express or implied, with respect to  *
'*   this software and accompanying documentation.  In *
'*   no event shall the author of this software be     *
'*   liable for any damages arising out of the use of  *
'*   this product. Your use of this software indicates *
'*   that you have read and agreed to these terms.     *
'*                                                     *
'*   Other then that, you may use this program's       *
'*   source code in any way you find useful.           *
'*                                                     *
'*                                                     *
'*******************************************************

' first identify yourself
Const AppName = "theTime"
Const Version = "2.5"
Const Company = "Visual Bits"
Const CopyRight = "Copyright ⌐ 1995"

' variables used throughout this form
Dim MyRect As RECT
Dim BorderSize As Integer, TitleSize As Integer
Dim dtw As Integer, dth As Integer ' short for desktop width & height
Dim TopMost As Integer
Dim Border As Integer, OldBorder As Integer
Dim Stuck As Integer
Dim Zoomed As Integer
Dim hMyMenu As Integer

' Background modes
Const BM_SOLID = 0
Const BM_BITMAP = 1
Const BM_TRANSPARENT = 2

Dim BackMode As Integer
Dim BackBmp As String
Dim ErasingBackgrnd As Integer

Dim InitFile As String
Dim nl As String

' bit mask for date and time menu options
Dim DateOption As Integer
Const DO_DF = &H7
Const DO_MT = &H10
Const DO_DN = &H20
Const DO_FM = &H40
Const DO_FY = &H80
Const DO_1L = &H100

' bit mask for Font options
Const FO_3D = &H7
Const FO_BD = &H10
Const FO_IT = &H20
Const FO_ST = &H40
Const FO_UL = &H80

' save the last time and date displayed
Dim sTime As String, sDate As String

' the so called font factor, used to guess how large fonts should be
Dim FontFact As Single

Sub AdjustForm (f As Form)
'*******************************************************
'*                                                     *
'*   Adjust the position of a form to be either just   *
'*   above the main form or just below it, but never   *
'*   off the screen.                                   *
'*                                                     *
'*******************************************************

    Dim fLeft As Integer, ftop As Integer, gap As Integer
    Dim i As Integer

    gap = BorderSize * Tpx

    ' put the horizontal position in the middle of the time
    fLeft = Left - (f.Width - Width) \ 2

    ' but not off the screen
    i = Screen.Width - f.Width - gap
    If fLeft > i Then fLeft = i
    If fLeft < gap Then fLeft = gap

    ' put the vertical postion above or below the time
    If Top + Height \ 2 > Screen.Height \ 2 Then
        ftop = Top - f.Height - gap
    Else
        ftop = Top + Height + gap
    End If

    ' or in the middle of the time if off the screen
    i = Screen.Height - f.Height - gap
    If ftop < gap Or ftop > i Then
        ftop = Top + (Height - f.Height) \ 2
    End If
    f.Move fLeft, ftop
End Sub

Sub CheckBackItem ()
'*******************************************************
'*                                                     *
'*   Check the background mode menu items and set      *
'*   BackMode accordingly.                             *
'*                                                     *
'*******************************************************

    Dim hSubMenu As Integer

    hSubMenu = GetSubMenu(hMyMenu, 4)
    CheckMenuItem hSubMenu, BackMode, MF_BYPOSITION Or MF_CHECKED
    CheckMenuItem hSubMenu, (BackMode Xor 3) And BM_BITMAP, MF_BYPOSITION Or MF_UNCHECKED
    CheckMenuItem hSubMenu, (BackMode Xor 3) And BM_TRANSPARENT, MF_BYPOSITION Or MF_UNCHECKED
End Sub

Function CreateMyMenu () As Integer
'*******************************************************
'*                                                     *
'*   This creates the menu that is inserted into the   *
'*   system menu and pops up whenever the right button *
'*   is clicked.  Note that using a VB created menu    *
'*   is not possible since a VB menu must be visible   *
'*   on the form menu line to be popped up.            *
'*                                                     *
'*******************************************************

    Dim hMenu As Integer, hSub1Menu As Integer, hSub2Menu As Integer
    Dim checked As Integer

    hMenu = CreateMenu()
    checked = 0: If TopMost = HWND_TOPMOST Then checked = MF_CHECKED
    AppendMenu hMenu, MF_STRING Or checked, 100, ("&Keep On Top")
    checked = 0: If Border Then checked = MF_CHECKED
    AppendMenu hMenu, MF_STRING Or checked, 200, ("&Title Bar")
    checked = 0: If Stuck Then checked = MF_CHECKED
    AppendMenu hMenu, MF_STRING Or checked, 700, ("&Stuck")

    AppendMenu hMenu, MF_SEPARATOR, 0, 0&
    hSub1Menu = CreateMenu()
    checked = 0: If BackMode = BM_SOLID Then checked = MF_CHECKED
    AppendMenu hSub1Menu, MF_STRING Or checked, 310, ("&Solid Background")
    checked = 0: If BackMode = BM_BITMAP Then checked = MF_CHECKED
    AppendMenu hSub1Menu, MF_STRING Or checked, 320, ("&Load Bitmap...")
    checked = 0: If BackMode = BM_TRANSPARENT Then checked = MF_CHECKED
    AppendMenu hSub1Menu, MF_STRING Or checked, 330, ("&Transparent")

    AppendMenu hSub1Menu, MF_SEPARATOR, 0, 0&
    AppendMenu hSub1Menu, MF_STRING, 340, ("&Background Color...")
    AppendMenu hMenu, MF_POPUP, hSub1Menu, ("&Background")

    hSub1Menu = CreateMenu()
    AppendMenu hSub1Menu, MF_STRING, 420, ("&Font...")
    hSub2Menu = CreateMenu()
    checked = 0: If TimePan.Font3D = 0 Then checked = MF_CHECKED
    AppendMenu hSub2Menu, MF_STRING Or checked, 410, ("&1 None")
    checked = 0: If TimePan.Font3D = 1 Then checked = MF_CHECKED
    AppendMenu hSub2Menu, MF_STRING Or checked, 411, ("&2 Block Left")
    checked = 0: If TimePan.Font3D = 2 Then checked = MF_CHECKED
    AppendMenu hSub2Menu, MF_STRING Or checked, 412, ("&3 Block Right")
    checked = 0: If TimePan.Font3D = 3 Then checked = MF_CHECKED
    AppendMenu hSub2Menu, MF_STRING Or checked, 413, ("&4 Drop Left")
    checked = 0: If TimePan.Font3D = 4 Then checked = MF_CHECKED
    AppendMenu hSub2Menu, MF_STRING Or checked, 414, ("&5 Drop Right")
    AppendMenu hSub1Menu, MF_POPUP, hSub2Menu, ("Font &3D Options")

    hSub2Menu = CreateMenu()
    AppendMenu hSub2Menu, MF_STRING, 418, ("&Increase")
    AppendMenu hSub2Menu, MF_STRING, 416, ("&Decrease")
    AppendMenu hSub2Menu, MF_STRING, 419, ("I&ncrease More")
    AppendMenu hSub2Menu, MF_STRING, 415, ("D&ecrease More")
    AppendMenu hSub1Menu, MF_POPUP, hSub2Menu, ("Font 3D &Sizes")

    AppendMenu hSub1Menu, MF_STRING, 425, ("Font 3D &Color...")

    AppendMenu hSub1Menu, MF_SEPARATOR, 0, 0&
    checked = 0: If DateOption And DO_MT Then checked = MF_CHECKED
    AppendMenu hSub1Menu, MF_STRING Or checked, 430, ("Military &Time")
    checked = 0: If DateOption And DO_DN Then checked = MF_CHECKED
    AppendMenu hSub1Menu, MF_STRING Or checked, 440, ("Full &Day")
    checked = 0: If DateOption And DO_FM Then checked = MF_CHECKED
    AppendMenu hSub1Menu, MF_STRING Or checked, 450, ("Full &Month")
    checked = 0: If DateOption And DO_FY Then checked = MF_CHECKED
    AppendMenu hSub1Menu, MF_STRING Or checked, 460, ("Full &Year")
    checked = 0: If DateOption And DO_1L Then checked = MF_CHECKED
    AppendMenu hSub1Menu, MF_STRING Or checked, 465, ("One &Line")
    AppendMenu hSub1Menu, MF_SEPARATOR, 0, 0&
    hSub2Menu = CreateMenu()
    checked = 0: If (DateOption And DO_DF) = 0 Then checked = MF_CHECKED
    AppendMenu hSub2Menu, MF_STRING Or checked, 470, ("&1 No Date")
    checked = 0: If (DateOption And DO_DF) = 1 Then checked = MF_CHECKED
    AppendMenu hSub2Menu, MF_STRING Or checked, 471, ("&2 m/d/y")
    checked = 0: If (DateOption And DO_DF) = 2 Then checked = MF_CHECKED
    AppendMenu hSub2Menu, MF_STRING Or checked, 472, ("&3 dd-mmm-y")
    checked = 0: If (DateOption And DO_DF) = 3 Then checked = MF_CHECKED
    AppendMenu hSub2Menu, MF_STRING Or checked, 473, ("&4 mmm dd, y")
    checked = 0: If (DateOption And DO_DF) = 4 Then checked = MF_CHECKED
    AppendMenu hSub2Menu, MF_STRING Or checked, 474, ("&4 mmm dd")
    AppendMenu hSub1Menu, MF_POPUP, hSub2Menu, ("Date &Options")
    AppendMenu hMenu, MF_POPUP, hSub1Menu, ("&Font && Time/Date Format")
    AppendMenu hMenu, MF_STRING, 500, ("Bevel && Border &Options...")
    AppendMenu hMenu, MF_SEPARATOR, 0, 0&
    AppendMenu hMenu, MF_STRING, 600, ("&About...")
    AppendMenu hMenu, MF_SEPARATOR, 0, 0&
    AppendMenu hMenu, MF_STRING, 900, ("E&xit")

    CreateMyMenu = hMenu

End Function

Sub EraseBackGrnd ()
'*******************************************************
'*                                                     *
'*   When theTime's form is transparent this routine   *
'*   deals with erasing the background and making it   *
'*   visible again.  Since the normal EraseBackgrnd    *
'*   message is captured the VB form never paints.     *
'*   Therefore by painting only the foreground of the  *
'*   Pizazz control the illusion of transparancy is    *
'*   created.  The big trick is whenever the form is   *
'*   moved or resized or painted you need to make the  *
'*   form briefly invisible so the real background is  *
'*   updated, then make the form visible and paint     *
'*   the foreground.  This routine does just that.     *
'*                                                     *
'*   ErasingBackgrnd is a state variable.              *
'*   0 : hide the window                               *
'*   -1: busy, go away                                 *
'*   1: window is hidden, so show it                   *
'*                                                     *
'*******************************************************

    Dim i As Integer


    If IsIconic(hWnd) = 0 And BackMode = BM_TRANSPARENT Then
        If ErasingBackgrnd = 0 Then
            ErasingBackgrnd = -1 ' working...
            ShowWindow hWnd, SW_HIDE
            DoEvents
            ErasingBackgrnd = 1
        ElseIf ErasingBackgrnd = 1 Then
            ErasingBackgrnd = -1 ' working...
            i = SW_SHOWNA
            If Stuck Then i = SW_SHOWNOACTIVATE
            ShowWindow hWnd, i
            DoEvents
            ErasingBackgrnd = 0 ' all done
        End If
    End If
End Sub

Sub Form_KeyDown (keycode As Integer, Shift As Integer)
'*******************************************************
'*                                                     *
'*   Handle the keyboard from here.  Allow the form    *
'*   to be moved around the screen using the arrow     *
'*   and shift keys.                                   *
'*                                                     *
'*******************************************************

    Dim x As Integer, y As Integer, MyW As Integer, MyH As Integer

    If IsZoomed(hWnd) Or Stuck Then Exit Sub
    GetWindowRect hWnd, MyRect
    x = MyRect.Left
    y = MyRect.Top
    MyW = MyRect.Right - MyRect.Left
    MyH = MyRect.Bottom - MyRect.Top
    Select Case keycode
    Case KEY_LEFT
        If Shift = 1 Then
            x = 0
        Else
            x = x - 10
        End If
    Case KEY_UP
        If Shift = 1 Then
            y = 0
        Else
            y = y - 10
        End If
    Case KEY_RIGHT
        If Shift = 1 Then
            x = dtw - MyW
        Else
            x = x + 10
        End If
    Case KEY_DOWN
        If Shift = 1 Then
            y = dth - MyH
        Else
            y = y + 10
        End If
    End Select
    SetWindowPos hWnd, 0, x, y, 0, 0, SWP_NOSIZE
End Sub

Sub Form_Load ()
'*******************************************************
'*                                                     *
'*   This is the starting point.  Setup the global     *
'*   variables and the message blaster control, read   *
'*   the ini file, show the form, and start the timer. *
'*                                                     *
'*******************************************************

    Dim hSysMenu As Integer
    Dim aRect As RECT
    Dim s As String

    ' Initialize global variables
    Set CD = CmDialog1
    TopMost = HWND_NOTOPMOST
    Border = True
    DateOption = 1
    nl = Chr$(13) & Chr$(10)
    FontFact = 1#
    InitFile = app.Path & "\theTime.ini"
    ErasingBackgrnd = True

    ' Get the DeskTop (Screen) and non-client dimensions
    GetClientRect GetDeskTopWindow(), aRect
    dtw = aRect.Right
    dth = aRect.Bottom
    Tpx = Screen.TwipsPerPixelX: Tpy = Screen.TwipsPerPixelY
    BorderSize = (Width \ Tpx - ScaleWidth)
    TitleSize = (Height \ Tpy - ScaleHeight) - BorderSize
    BorderSize = BorderSize \ 2

    ' Setup the Message handling
    MsgBlaster1.hWndTarget = hWnd
    MsgBlaster1.MsgList(0) = WM_NCHITTEST
    MsgBlaster1.MsgPassage(0) = -1 ' preprocess
    MsgBlaster1.MsgList(1) = WM_RBUTTONDOWN
    MsgBlaster1.MsgPassage(1) = 0 ' eat it
    MsgBlaster1.MsgList(2) = WM_LBUTTONDBLCLK
    MsgBlaster1.MsgPassage(2) = 0 ' eat it
    MsgBlaster1.MsgList(3) = WM_NCRBUTTONDOWN
    MsgBlaster1.MsgPassage(3) = 0 ' eat it
    MsgBlaster1.MsgList(4) = WM_NCLBUTTONDBLCLK
    MsgBlaster1.MsgPassage(4) = 0 ' eat it
    MsgBlaster1.MsgList(5) = WM_COMMAND
    MsgBlaster1.MsgPassage(5) = 1 ' post process
    MsgBlaster1.MsgList(6) = WM_SYSCOMMAND
    MsgBlaster1.MsgPassage(6) = 1 ' post process
    MsgBlaster1.MsgList(7) = WM_DROPFILES
    MsgBlaster1.MsgPassage(7) = 1 ' post process
    MsgBlaster1.MsgList(8) = WM_MOUSEACTIVATE
    MsgBlaster1.MsgPassage(8) = 0' eat it
    MsgBlaster1.MsgList(9) = WM_ERASEBKGND
    MsgBlaster1.MsgPassage(9) = 0 'eat it
    MsgBlaster1.MsgList(10) = WM_MOVE
    MsgBlaster1.MsgPassage(10) = 1 'post process

    LoadInitFile

    DragAcceptFiles hWnd, True

    ' create our menu and add it to the system menu
    hMyMenu = CreateMyMenu()
    hSysMenu = GetSystemMenu(hWnd, 0)
    AppendMenu hSysMenu, MF_SEPARATOR, 0, 0&
    s = AppName & " Options"
    AppendMenu hSysMenu, MF_POPUP, hMyMenu, (s)

    SetBackMode
    ShowForm

    Timer1_Timer
    DoEvents

    ErasingBackgrnd = False
    OldBorder = Border
    Timer1.Enabled = True
End Sub

Sub Form_Resize ()
'*******************************************************
'*                                                     *
'*   When a form resizes and it's an icon put the time *
'*   in the caption.  When borders come or go we       *
'*   generally don't need to handle the resulting      *
'*   resize, unless the form has been maxed (zoomed).  *
'*   Otherwise, reset the caption, resize the font,    *
'*   and size the panel.  Oh, call EraseBackGrnd in    *
'*   case the form is transparent.                     *
'*                                                     *
'*******************************************************

    If IsIconic(hWnd) Then
        Caption = sTime
    ElseIf (OldBorder = Border) Or IsZoomed(hWnd) Then
        If ErasingBackgrnd = 0 Then EraseBackGrnd
        Caption = AppName
        ResizeFont
        TimePan.Move 0, 0, ScaleWidth, ScaleHeight
    End If
End Sub

Sub LoadBitMap ()
'*******************************************************
'*                                                     *
'*   Put up a common dialog box to load a bitmap file. *
'*                                                     *
'*******************************************************

    CD.DialogTitle = "Background Bitmap"
    CD.Filter = "BMP files|*.bmp|RLE Files|*.rle|All Files|*.*"
    CD.FilterIndex = 1
    CD.Filename = BackBmp
    CD.Flags = OFN_FILEMUSTEXIST
    CD.Action = DLG_FILE_OPEN
    Screen.MousePointer = 11
    Timer1.Enabled = False
    BackBmp = CD.Filename
    BackMode = BM_BITMAP
    SetBackMode
    Timer1.Enabled = True
    Screen.MousePointer = 0
End Sub

Sub LoadInitFile ()
'*******************************************************
'*                                                     *
'*   Read in the .ini file and set most of the global  *
'*   variables to reflect what you find.               *
'*                                                     *
'*******************************************************

    Dim i As Integer, j As Integer
    Dim f As String, p As String
    Dim R As String * 80

    'On Error Resume Next

    f = InitFile
    p = "Preferences"

    i = GetPrivateProfileString(p, "Position", "", R, 80, f)
    If i >= 7 Then
        j = 1: i = InStr(j, R, " "): If i Then MyRect.Left = Val(Mid$(R, j, i - j))
        j = i + 1: i = InStr(j, R, " "): If i Then MyRect.Right = Val(Mid$(R, j, i - j))
        j = i + 1: i = InStr(j, R, " "): If i Then MyRect.Top = Val(Mid$(R, j, i - j))
        j = i + 1: i = Len(R): If i > j Then MyRect.Bottom = Val(Mid$(R, j, i - j))
        ' the point of the next line is to position the form off the screen until
        ' after it is made visible by the ShowForm procedure
        ' otherwise you get an instant of "garbage" when the form is
        ' first made visible
        Move Screen.Width, Screen.Height
    Else
        ' Arbitrary position defaults
        i = 260 * Tpx
        j = 80 * Tpy
        Move Screen.Width - i, Screen.Height - j, i, j
        GetWindowRect hWnd, MyRect
    End If
    If MyRect.Left > dtw Then
        MyRect.Left = dtw \ 2 - 130
        MyRect.Right = dtw \ 2 + 130
    End If
    If MyRect.Top > dth Then
        MyRect.Top = dth \ 2 - 40
        MyRect.Bottom = dth \ 2 + 40
    End If

    Zoomed = (GetPrivateProfileInt(p, "State", 1, f) = SW_SHOWMAXIMIZED)

    If app.PrevInstance Then
        ' you can have more then one instance, but randomize the placement
        Zoomed = 0
        Randomize
        i = MyRect.Bottom - MyRect.Top
        MyRect.Top = (dth - i) * Rnd
        MyRect.Bottom = MyRect.Top + i
        i = MyRect.Right - MyRect.Left
        MyRect.Left = (dtw - i) * Rnd
        MyRect.Right = MyRect.Left + i
    End If

    TopMost = GetPrivateProfileInt(p, "TopMost", -2, f)

    Border = GetPrivateProfileInt(p, "Border", True, f)
    If Border = False Then
        MsgBlaster1.MsgPassage(2) = 0 'eat WM_NCLBUTTONDBLCLK
    End If
    OldBorder = Border

    Stuck = GetPrivateProfileInt(p, "Stuck", False, f)

    i = GetPrivateProfileString(p, "BackColor", "", R, 80, f)
    If i >= 1 Then TimePan.BackColor = Val(R)
    i = GetPrivateProfileString(p, "ForeColor", "", R, 80, f)
    If i >= 1 Then TimePan.ForeColor = Val(R)
    i = GetPrivateProfileString(p, "FontName", "", R, 80, f)
    If i >= 1 Then TimePan.FontName = Left$(R, i)
    i = GetPrivateProfileString(p, "FontOption", "", R, 80, f)
    If i >= 1 Then
        j = Val(R)
        TimePan.FontBold = j And FO_BD
        TimePan.FontItalic = j And FO_IT
        TimePan.FontStrikethru = j And FO_ST
        TimePan.FontUnderline = j And FO_UL
        TimePan.Font3D = j And FO_3D
    End If
    i = GetPrivateProfileString(p, "FontFact", "", R, 80, f)
    If i >= 1 Then FontFact = Val(R)
    i = GetPrivateProfileString(p, "Font3DColor", "", R, 80, f)
    If i >= 1 Then TimePan.Font3DColor = Val(R)
    TimePan.Font3DSize = GetPrivateProfileInt(p, "Font3DSize", 0, f)

    TimePan.BevelInner = GetPrivateProfileInt(p, "BevelInner", 1, f)
    TimePan.BevelOuter = GetPrivateProfileInt(p, "BevelOuter", 2, f)
    TimePan.BevelInnerShading = GetPrivateProfileInt(p, "BevelInnerShading", 0, f)
    TimePan.BevelOuterShading = GetPrivateProfileInt(p, "BevelOuterShading", 0, f)
    TimePan.BevelInnerWidth = GetPrivateProfileInt(p, "BevelInnerWidth", 1, f)
    TimePan.BevelOuterWidth = GetPrivateProfileInt(p, "BevelOuterWidth", 2, f)
    TimePan.BorderInner = GetPrivateProfileInt(p, "BorderInner", 0, f)
    TimePan.BorderOuter = GetPrivateProfileInt(p, "BorderOuter", 0, f)
    TimePan.BorderInnerWidth = GetPrivateProfileInt(p, "BorderInnerWidth", 0, f)
    TimePan.BorderOuterWidth = GetPrivateProfileInt(p, "BorderOuterWidth", 0, f)
    i = GetPrivateProfileString(p, "BorderInnerColor", "", R, 80, f)
    If i >= 1 Then TimePan.BorderInnerColor = Val(R)
    i = GetPrivateProfileString(p, "BorderOuterColor", "", R, 80, f)
    If i >= 1 Then TimePan.BorderOuterColor = Val(R)

    i = GetPrivateProfileString(p, "DateOption", "", R, 80, f)
    If i >= 1 Then DateOption = Val(R)

    j = 0
    i = GetPrivateProfileString(p, "BackMode", "", R, 80, f)
    If i >= 1 Then
        BackMode = Val(R)
        If BackMode = BM_BITMAP Then BackBmp = Mid$(R, 3, i - 2)
    End If
End Sub

Sub MakeAboutMsg ()
'*******************************************************
'*                                                     *
'*   Make a shameless self promotion for yourself.     *
'*                                                     *
'*******************************************************

    Dim s As String

    s = AppName & " " & Version & nl
    s = s & "by " & Company
    AboutFrm!AboutLab(0) = s
    s = "P.O. Box 243" & nl
    s = s & "Watertown, MA 02272" & nl
    s = s & "CIS: 70402, 3651" & nl
    s = s & "E-Mail: [e-mail]" & nl
    s = s & CopyRight
    AboutFrm!AboutLab(1) = s
    s = "   theTime is a free program written in "
    s = s & "Visual Basic 3.0 - see technote.txt for the "
    s = s & "techy details and see theTime.wri for "
    s = s & "information about using it.... "
    s = s & "Enjoy!   (Ben Jones)"
    AboutFrm!AboutLab(2) = s
End Sub

Sub MenuStuff (ByVal index As Integer, CheckIt As Integer)
'*******************************************************
'*                                                     *
'*   Manage the checking and unchecking of menu items. *
'*                                                     *
'*******************************************************

    Dim hSubMenu As Integer, checked As Integer

    checked = MF_UNCHECKED
    hSubMenu = GetSubMenu(hMyMenu, 5)
    If CheckIt Then checked = MF_CHECKED
    CheckMenuItem hSubMenu, index, MF_BYPOSITION Or checked
    ' make the changes happen instantly
    Timer1_Timer
End Sub

Sub MsgBlaster1_Message (MsgVal As Integer, wparam As Integer, lParam As Long, ReturnVal As Long)
'*******************************************************
'*                                                     *
'*   Event handler for the ModBlaster control which    *
'*   is a slightly modified version of MsgBlaster that *
'*   is found and documented on the MSDN CD.           *
'*                                                     *
'*******************************************************

    Dim hSubMenu As Integer
    Dim checked As Integer
    Dim lpoint As Long
    Dim R As String * 80

    Select Case MsgVal

        Case WM_NCHITTEST
            ' if there's no title/border and not maximized and not stuck then
            ' and the click is in the client area then change it into a title
            ' bar click so the window can be moved be clicking and dragging it
            If ReturnVal = HTCLIENT And Not Border And IsZoomed(hWnd) = 0 And Not Stuck Then
                ReturnVal = HTCAPTION
            End If

        Case WM_RBUTTONDOWN, WM_NCRBUTTONDOWN
            ' pop up the menu on a right mouse click in the client area
            ' which would be in the non client area (title bar) when
            ' there is no title bar cause of what we did above
            lpoint = lParam
            If MsgVal = WM_RBUTTONDOWN Then
                ClientToScreenBylong hWnd, lpoint
            ElseIf Border Then
                GoTo NoPopupMenu ' one goto per program I always say...
            End If
            checked = TrackPopupMenu(hMyMenu, 0, mbLoWord(lpoint), mbHiWord(lpoint), 0, hWnd, 0)
NoPopupMenu:
            ReturnVal = 0 ' this is required when if eat it

        Case WM_NCLBUTTONDBLCLK
            ' switch to a title bar/border if there isn't one
            If Not Border Then
                Border = True
                ShowTime
                CheckMenuItem hMyMenu, 1, MF_BYPOSITION Or MF_CHECKED
                MsgBlaster1.MsgPassage(2) = 1 'let windows post process WM_NCLBUTTONDBLCLK
            End If
            ReturnVal = 0 ' this is required if we eat it

        Case WM_LBUTTONDBLCLK
            ' get rid of the title bar/border if there is one
            Border = Not Border
            ShowTime
            CheckMenuItem hMyMenu, 1, MF_BYPOSITION Or MF_UNCHECKED
            MsgBlaster1.MsgPassage(2) = 0 'eat WM_NCLBUTTONDBLCLK
            ReturnVal = 0 ' this is required if we eat it

        Case WM_MOUSEACTIVATE
            ' if stuck then avoid getting focus
            If Stuck Then
                ReturnVal = MA_NOACTIVATE
            Else
                ReturnVal = 0 ' this is required when if eat it
            End If

        Case WM_MOVE
            If ErasingBackgrnd = 0 Then EraseBackGrnd

        Case WM_ERASEBKGND
            EraseBackGrnd
            '  suppress normal erase backgound proccesing
            ReturnVal = 1

        Case WM_DROPFILES
            If DragQueryFile(wparam, 0, R, 80) Then
                'Debug.Print "dropfile, begin"
                Timer1.Enabled = False
                BackBmp = R
                BackMode = BM_BITMAP
                SetBackMode
                CheckBackItem
                Timer1.Enabled = True
            End If
            DragFinish wparam
            Refresh
            ReturnVal = 0
            'Debug.Print "dropfile, end"

        Case WM_SYSCOMMAND, WM_COMMAND
            ReturnVal = False ' this prevents post-processing by the modblaster control
            checked = MF_CHECKED
            ' cancel fetching the background
            Select Case wparam
                Case 100 ' Top most
                    If TopMost = HWND_NOTOPMOST Then
                        TopMost = HWND_TOPMOST
                    Else
                        checked = MF_UNCHECKED
                        TopMost = HWND_NOTOPMOST
                    End If
                    CheckMenuItem hMyMenu, 0, MF_BYPOSITION Or checked
                    ShowTime
                Case 200 ' Title Bar
                    Border = Not Border
                    If Not Border Then
                        checked = MF_UNCHECKED
                        MsgBlaster1.MsgPassage(2) = 0 'eat WM_NCLBUTTONDBLCLK
                    End If
                    CheckMenuItem hMyMenu, 1, MF_BYPOSITION Or checked
                    ShowTime
                Case 700 ' Stuck
                    Stuck = Not Stuck
                    If Not Stuck Then
                        checked = MF_UNCHECKED
                        SetFocus
                    End If
                    CheckMenuItem hMyMenu, 2, MF_BYPOSITION Or checked
                Case 310
                    BackMode = BM_SOLID
                    SetBackMode
                    CheckBackItem
                Case 320
                    LoadBitMap
                    CheckBackItem
                Case 330
                    BackMode = BM_TRANSPARENT
                    SetBackMode
                    CheckBackItem
                Case 340 ' Background Color
                    CD.Flags = CC_RGBINIT
                    CD.Color = TimePan.BackColor
                    CD.Action = DLG_COLOR
                    TimePan.BackColor = CD.Color
                Case 410 To 414 ' Font 3d Options
                    hSubMenu = GetSubMenu(hMyMenu, 5)
                    hSubMenu = GetSubMenu(hSubMenu, 0)
                    CheckMenuItem hSubMenu, TimePan.Font3D, MF_BYPOSITION Or MF_UNCHECKED
                    CheckMenuItem hSubMenu, wparam - 410, MF_BYPOSITION Or MF_CHECKED
                    TimePan.Font3D = wparam - 410
                Case 415 To 419 ' Font 3d Size
                    checked = TimePan.Font3DSize + wparam - 417
                    If checked > 0 And checked <= 30 Then
                        TimePan.Font3DSize = checked
                    End If
                Case 420 ' thetime fonts
                    CD.Color = TimePan.ForeColor
                    CD.FontBold = TimePan.FontBold
                    CD.FontItalic = TimePan.FontItalic
                    CD.FontName = TimePan.FontName
                    CD.FontSize = TimePan.FontSize
                    CD.FontStrikeThru = TimePan.FontStrikethru
                    CD.FontUnderLine = TimePan.FontUnderline
                    CD.Flags = CF_BOTH Or CF_EFFECTS
                    CD.Action = DLG_FONT
                    TimePan.ForeColor = CD.Color
                    TimePan.FontBold = CD.FontBold
                    TimePan.FontItalic = CD.FontItalic
                    TimePan.FontName = CD.FontName
                    FontFact = FontFact * CD.FontSize / TimePan.FontSize
                    TimePan.FontSize = CD.FontSize
                    TimePan.FontStrikethru = CD.FontStrikeThru
                    TimePan.FontUnderline = CD.FontUnderLine
                Case 425 ' Font 3D Color
                    CD.Flags = CC_RGBINIT
                    CD.Color = TimePan.Font3DColor
                    CD.Action = DLG_COLOR
                    TimePan.Font3DColor = CD.Color
                Case 430' Military Time
                    DateOption = DateOption Xor DO_MT
                    MenuStuff 3, DateOption And DO_MT
                Case 440' Full Day
                    DateOption = DateOption Xor DO_DN
                    MenuStuff 4, DateOption And DO_DN
                Case 450' Full Month
                    DateOption = DateOption Xor DO_FM
                    MenuStuff 5, DateOption And DO_FM
                Case 460' Full Year
                    DateOption = DateOption Xor DO_FY
                    MenuStuff 6, DateOption And DO_FY
                Case 465' Two Lines
                    DateOption = DateOption Xor DO_1L
                    MenuStuff 7, DateOption And DO_1L
                Case 470 To 474' Date Options
                    hSubMenu = GetSubMenu(hMyMenu, 5)
                    hSubMenu = GetSubMenu(hSubMenu, 9)
                    CheckMenuItem hSubMenu, DateOption And DO_DF, MF_BYPOSITION Or MF_UNCHECKED
                    CheckMenuItem hSubMenu, wparam - 470, MF_BYPOSITION Or MF_CHECKED
                    DateOption = (DateOption And (Not DO_DF)) Or wparam - 470
                    Timer1_Timer
                Case 500' Bevels
                    ShowBevelOptFrm
                Case 600' About
                    ShowAboutFrm
                Case 900' Exit - but don't end in the middle of this message
                    SaveInitFile
                    If (GetAsyncKeyState(VK_SHIFT) And &H8000) = 0 Then
                        ' shift key not pressed, go ahead and exit
                        ' first un-subclass everybody
                        MsgBlaster1.hWndTarget = 0
                        MsgBlaster1.hWndTarget = 0
                        FreeLibrary (GetModuleHandle("modblast.vbx"))
                        End
                    End If
                Case SC_CLOSE ' handle this so we can un-subclass and free the library
                    SaveInitFile
                    ReturnVal = True ' enable post-processing
                Case Else
                    ReturnVal = True ' enable post-processing
            End Select
    End Select
End Sub

Sub ResizeFont ()
'*******************************************************
'*                                                     *
'*   Attempt to resize the font proportionately to the *
'*   size of theTime's panel.  FontFact keeps track of *
'*   the size of the font relative to the form.  It's  *
'*   a kludge but it seems to work.                    *
'*                                                     *
'*******************************************************

    Dim Fsw As Single, Fsh As Single
    Dim lines As Single, x As Single
    Dim aRect As RECT
    Dim i As Integer, j As Integer

    If InStr(sDate, nl) Then
        lines = 2.5
        j = Len(sDate) - 1
        If j < Len(sTime) Then
            j = Len(sTime)
        End If
    Else
        lines = 1.5
        j = Len(sDate & sTime)
        If j = 0 Then Exit Sub
    End If

    If TimePan.BorderOuter Then i = i + TimePan.BorderOuterWidth
    If TimePan.BevelOuter Then i = i + TimePan.BevelInnerWidth
    If TimePan.BorderInner Then i = i + TimePan.BorderInnerWidth
    If TimePan.BevelInner Then i = i + TimePan.BevelInnerWidth

    GetClientRect hWnd, aRect
    InflateRect aRect, -i, -i

    Fsw = (aRect.Right - aRect.Left) * Tpx * FontFact / (10 * j) ' how big can the fonts be according to width
    Fsh = (aRect.Bottom - aRect.Top) * Tpy * FontFact / (20 * lines)' ... according to height

    If Fsw < Fsh Then
        x = Fsw
    Else
        x = Fsh
    End If
    If x < 8# Then x = 8#
    TimePan.FontSize = x
End Sub

Sub SaveInitFile ()
'*******************************************************
'*                                                     *
'*   Write the ini file.                               *
'*                                                     *
'*******************************************************

    Dim i As Integer
    Dim f As String, p As String, s As String
    Dim MyPlace As WINDOWPLACEMENT

    If app.PrevInstance Then
        Exit Sub
    End If
    Screen.MousePointer = 11
    f = InitFile
    p = "Preferences"
    MyPlace.Length = 22

    GetWindowPlacement hWnd, MyPlace
    CopyRect MyRect, MyPlace.rcNormalPosition
    s = Str$(MyRect.Left) & Str$(MyRect.Right) & Str$(MyRect.Top) & Str$(MyRect.Bottom)
    i = WritePrivateProfileString(p, "Position", s, f)
    i = WritePrivateProfileString(p, "State", Str$(MyPlace.ShowCmd), f)
    i = WritePrivateProfileString(p, "TopMost", Str$(TopMost), f)
    i = WritePrivateProfileString(p, "Border", Str$(Border), f)
    i = WritePrivateProfileString(p, "Stuck", Str$(Stuck), f)
    i = WritePrivateProfileString(p, "BackColor", "&h" & Hex$(TimePan.BackColor) & "&", f)
    i = WritePrivateProfileString(p, "ForeColor", "&h" & Hex$(TimePan.ForeColor) & "&", f)
    i = WritePrivateProfileString(p, "FontName", TimePan.FontName, f)
    i = TimePan.Font3D
    If TimePan.FontBold Then i = i Or FO_BD
    If TimePan.FontItalic Then i = i Or FO_IT
    If TimePan.FontStrikethru Then i = i Or FO_ST
    If TimePan.FontUnderline Then i = i Or FO_UL
    i = WritePrivateProfileString(p, "FontOption", "&h" & Hex$(i), f)
    i = WritePrivateProfileString(p, "FontFact", Str$(FontFact), f)
    i = WritePrivateProfileString(p, "Font3DColor", "&h" & Hex$(TimePan.Font3DColor) & "&", f)
    i = WritePrivateProfileString(p, "Font3DSize", Str$(TimePan.Font3DSize), f)

    i = WritePrivateProfileString(p, "BevelInner", Str$(TimePan.BevelInner), f)
    i = WritePrivateProfileString(p, "BevelOuter", Str$(TimePan.BevelOuter), f)
    i = WritePrivateProfileString(p, "BevelInnerShading", Str$(TimePan.BevelInnerShading), f)
    i = WritePrivateProfileString(p, "BevelOuterShading", Str$(TimePan.BevelOuterShading), f)
    i = WritePrivateProfileString(p, "BevelInnerWidth", Str$(TimePan.BevelInnerWidth), f)
    i = WritePrivateProfileString(p, "BevelOuterWidth", Str$(TimePan.BevelOuterWidth), f)

    i = WritePrivateProfileString(p, "BorderInner", Str$(TimePan.BorderInner), f)
    i = WritePrivateProfileString(p, "BorderOuter", Str$(TimePan.BorderOuter), f)
    i = WritePrivateProfileString(p, "BorderInnerWidth", Str$(TimePan.BorderInnerWidth), f)
    i = WritePrivateProfileString(p, "BorderOuterWidth", Str$(TimePan.BorderOuterWidth), f)
    i = WritePrivateProfileString(p, "BorderInnerColor", "&h" & Hex$(TimePan.BorderInnerColor) & "&", f)
    i = WritePrivateProfileString(p, "BorderOuterColor", "&h" & Hex$(TimePan.BorderOuterColor) & "&", f)

    i = WritePrivateProfileString(p, "DateOption", "&h" & Hex$(DateOption), f)
    s = Str$(BackMode) & " " & BackBmp
    i = WritePrivateProfileString(p, "Backmode", s, f)
    Screen.MousePointer = 0
End Sub

Sub SetBackMode ()
'*******************************************************
'*                                                     *
'*   Set the background modeont proportionately to the *
'*   size of theTime's panel.  FontFact keeps track of *
'*   the size of the font relative to the form.  It's  *
'*   a kludge but it seems to work.                    *
'*                                                     *
'*******************************************************

    On Error Resume Next
    TimePan.BackStyle = 1
    If BackMode = BM_SOLID Then
        TimePan.Picture = LoadPicture("")
        BackBmp = ""
    ElseIf BackMode = BM_BITMAP Then ' loading a bitmap
        TimePan.Picture = LoadPicture(BackBmp)
        If Err <> 0 Then
            MsgBox "Error loading " & BackBmp & nl & "Invalid bitmap file format!", 48
            ' no bitmap loaded
            BackMode = BM_SOLID
            BackBmp = ""
        End If
    Else
        TimePan.BackStyle = 0
        ' the next two lines do about the same thing. One advantage to using
        ' InvalidateRectbynum is that erasing the background can be turned off
        'InvalidateRectbynum hwnd, 0, True
        Refresh
    End If
End Sub

Sub ShowAboutFrm ()
'*******************************************************
'*                                                     *
'*   Show a shameless self promotion.                  *
'*                                                     *
'*******************************************************

    Dim i As Integer

    MakeAboutMsg
    AdjustForm AboutFrm
    AboutFrm.Caption = "About " & AppName
    AboutFrm!AboutPan.Icon = Icon
    ' this form might need to be set topmost
    SetWindowPos AboutFrm.hWnd, TopMost, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE
    AboutFrm.Show 1
    Unload AboutFrm
End Sub

Sub ShowBevelOptFrm ()
'*******************************************************
'*                                                     *
'*   Now for the really interesting stuff.  Show a     *
'*   dialog box that is almost entirely created out of *
'*   PZLabels.  PZLabels are part of Pizazz.vbx, an    *
'*   inexpensize VBX that can be purchased through     *
'*   Compuserve (#6551).   Remarkably enough, it is    *
'*   possible to make tabs, 3D options, and 3D spin    *
'*   buttons with a little code and Pizazz!.           *
'*                                                     *
'*******************************************************

    Dim f As Form, T As PZLabel
    ReDim opt(1) As Integer
    Dim i As Integer

    ' use object variables to make my typing easier!
    Set f = BevelOptFrm
    Set T = TimePan

    AdjustForm f

    ' pass properties using tags
    f!TabPan.Tag = "0" ' set the "up" tab
    f!Tabs(0).Tag = Str$(T.BevelOuter)
    f!Tabs(1).Tag = Str$(T.BevelInner)
    f!Tabs(2).Tag = Str$(T.BorderOuter)
    f!Tabs(3).Tag = Str$(T.BorderInner)
    f!WidthLab(0) = Str$(T.BevelOuterWidth)
    f!WidthLab(1) = Str$(T.BevelInnerWidth)
    f!WidthLab(2) = Str$(T.BorderOuterWidth)
    f!WidthLab(3) = Str$(T.BorderInnerWidth)

    ' setting the bevel shade options is confusing because
    ' the "white light" option reverses its value depending
    ' on the "black shade" option
    opt(0) = T.BevelOuterShading
    opt(1) = T.BevelInnerShading
    For i = 0 To 1
        ' there are four color option buttons, two for each property
        f!ColorOpt(i * 2).Tag = Str$((opt(i) < 2 Xor opt(i)) And 1)
        f!ColorOpt(i * 2 + 1).Tag = Str$(opt(i) And 2)
    Next

    f!ColorOpt(4).Tag = Str$(T.BorderOuterColor)
    f!ColorOpt(6).Tag = Str$(T.BorderInnerColor)

    ' might need to be set topmost
    SetWindowPos BevelOptFrm.hWnd, TopMost, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE
    f.Show 1
    If Trim$(f.Tag) = "1" Then
        ' OK was pressed
        T.BevelOuter = Val(f!Tabs(0).Tag)
        T.BevelInner = Val(f!Tabs(1).Tag)
        T.BorderOuter = Val(f!Tabs(2).Tag)
        T.BorderInner = Val(f!Tabs(3).Tag)
        T.BevelOuterWidth = Val(f!WidthLab(0))
        T.BevelInnerWidth = Val(f!WidthLab(1))
        T.BorderOuterWidth = Val(f!WidthLab(2))
        T.BorderInnerWidth = Val(f!WidthLab(3))
        For i = 0 To 1
            opt(i) = Val(f!ColorOpt(i * 2 + 1).Tag)
            opt(i) = opt(i) + Val(f!ColorOpt(i * 2).Tag) Xor (opt(i) < 2) And 1
        Next
        T.BevelOuterShading = opt(0)
        T.BevelInnerShading = opt(1)

        T.BorderOuterColor = Val(f!ColorOpt(4).Tag)
        T.BorderInnerColor = Val(f!ColorOpt(6).Tag)

        ResizeFont
    End If
    Unload BevelOptFrm
End Sub

Sub ShowForm ()
'*******************************************************
'*                                                     *
'*   Show theTime's form.  Can't just do a show method *
'*   because the form's title and borders may or may   *
'*   not be present and the form may have the TopMost  *
'*   position and good old VB doesn't support setting  *
'*   these things at run time.                         *
'*                                                     *
'*******************************************************

    Dim x As Integer, y As Integer
    Dim w As Integer, h As Integer
    Dim i As Integer
    Dim Clrect As RECT
    Dim MyPlace As WINDOWPLACEMENT
    Dim l As Long

    If Border Then
        l = WS_OVERLAPPEDWINDOW Or WS_VISIBLE
    Else
        l = WS_VISIBLE
    End If
    If Zoomed Then
        l = l Or WS_MAXIMIZE
    End If
    l = SetWindowLong(hWnd, GWL_STYLE, l)
    If Zoomed = 0 Then
        x = MyRect.Left
        y = MyRect.Top
        w = MyRect.Right - x
        h = MyRect.Bottom - y
        If x > dtw - BorderSize Then
            x = dtw - w
        End If
        If y > dth - BorderSize Then
            y = dth - h
        End If
    Else
        If Border Then i = BorderSize
        x = -i
        y = -i
        w = dtw + 2 * i
        h = dth + 2 * i
    End If

    ' the next line fires the move and form resize event and makes
    ' the form visible
    ' (note this is only way to set topmost)
    SetWindowPos hWnd, TopMost, x, y, w, h, SWP_NOACTIVATE
    If Not Stuck Then SetFocus
    If Zoomed Then
        MyPlace.Length = 22
        GetWindowPlacement hWnd, MyPlace
        CopyRect MyPlace.rcNormalPosition, MyRect
        SetWindowPlacement hWnd, MyPlace
    End If
    TimePan.Visible = True
End Sub

Sub ShowTime ()
'*******************************************************
'*                                                     *
'*   Set the border and title or lack thereof window   *
'*   style and the topmost position while you're at    *
'*   it.                                               *
'*                                                     *
'*******************************************************

    Dim l As Long
    Dim x As Integer, y As Integer
    Dim w As Integer, h As Integer
    Dim i As Integer
    Dim flag As Long
    Dim Clrect As RECT

    If Border <> OldBorder Then
        GetWindowRect hWnd, MyRect
        GetClientRect hWnd, Clrect
        Zoomed = IsZoomed(hWnd)
        flag = WS_VISIBLE ' no border, no caption, no nothin
        If Zoomed = 0 Then
            If Border Then
                x = MyRect.Left - BorderSize
                y = MyRect.Top - TitleSize - BorderSize
                w = MyRect.Right - MyRect.Left + 2 * BorderSize
                h = MyRect.Bottom - MyRect.Top + TitleSize + 2 * BorderSize
            Else
                x = MyRect.Left + BorderSize
                y = MyRect.Top + TitleSize + BorderSize
                w = Clrect.Right - Clrect.Left
                h = Clrect.Bottom - Clrect.Top
            End If
        Else
            If Border Then i = BorderSize
            x = -i
            y = -i
            w = dtw + 2 * i
            h = dth + 2 * i
        End If
        If Border Then
            flag = flag Or WS_OVERLAPPEDWINDOW Or WS_VISIBLE ' back to normal
        End If
        If Zoomed Then
            flag = flag Or WS_MAXIMIZE
        End If
        l = SetWindowLong(hWnd, GWL_STYLE, flag)
        SetWindowPos hWnd, TopMost, x, y, w, h, SWP_NOACTIVATE
        OldBorder = Border
    Else
        SetWindowPos hWnd, TopMost, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE
    End If
End Sub

Sub Timer1_Timer ()
'*******************************************************
'*                                                     *
'*   Event handler for the timer.  Update the time.    *
'*                                                     *
'*******************************************************

    Dim mm As String, yy As String

    sTime = "h:mm"
    If (DateOption And DO_MT) = 0 Then sTime = sTime & " A/P"
    sDate = ""
    If DateOption And DO_DN Then sDate = "dddd "
    mm = "mmm"
    If DateOption And DO_FM Then mm = "mmmm"
    yy = "yy  "
    If DateOption And DO_FY Then yy = "yyyy  "
    Select Case DateOption And DO_DF
        Case 0 'no date
        Case 1 'd/m/y
            sDate = sDate & "m/d/" & yy
        Case 2 'm-d-y
            sDate = sDate & "dd-" & mm & "-" & yy
        Case 3 'm d, y
            sDate = sDate & mm & " d, " & yy
        Case 4 'm d
            sDate = sDate & mm & " d  "
    End Select
    If sDate <> "" Then
        sDate = Format$(Now, sDate)
    End If
    If Command$ <> "" Then
        sDate = Command$ & " " & sDate
    End If
    If sDate <> "" And ((DateOption And DO_1L) = 0) Then
        sDate = RTrim$(sDate) & nl ' two lines
    End If
    sTime = Format$(Now, sTime)
    If IsIconic(hWnd) Then
        If sTime <> Caption Then Caption = sTime
    ElseIf sDate & sTime <> TimePan.Caption Then
        ResizeFont
        TimePan.Caption = sDate & sTime
        EraseBackGrnd
    End If
    If ErasingBackgrnd = 1 Then EraseBackGrnd
End Sub